home *** CD-ROM | disk | FTP | other *** search
/ Almathera Ten Pack 1: Comms & Networking / Almathera Ten on Ten - Disc 1: Comms & Networking.iso / amiga-useful / perl / src / cons.c < prev    next >
C/C++ Source or Header  |  1995-05-04  |  36KB  |  1,443 lines
  1. /* $RCSfile: cons.c,v $$Revision: 4.0.1.3 $$Date: 92/06/08 12:18:35 $
  2.  *
  3.  *    Copyright (c) 1991, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  * $Log:    cons.c,v $
  9.  * Revision 4.0.1.3  92/06/08  12:18:35  lwall
  10.  * patch20: removed implicit int declarations on funcions
  11.  * patch20: deleted some minor memory leaks
  12.  * patch20: fixed double debug break in foreach with implicit array assignment
  13.  * patch20: fixed confusion between a *var's real name and its effective name
  14.  * patch20: Perl now distinguishes overlapped copies from non-overlapped
  15.  * patch20: debugger sometimes displayed wrong source line
  16.  * patch20: various error messages have been clarified
  17.  * patch20: an eval block containing a null block or statement could dump core
  18.  * 
  19.  * Revision 4.0.1.2  91/11/05  16:15:13  lwall
  20.  * patch11: debugger got confused over nested subroutine definitions
  21.  * patch11: prepared for ctype implementations that don't define isascii()
  22.  * 
  23.  * Revision 4.0.1.1  91/06/07  10:31:15  lwall
  24.  * patch4: new copyright notice
  25.  * patch4: added global modifier for pattern matches
  26.  * 
  27.  * Revision 4.0  91/03/20  01:05:51  lwall
  28.  * 4.0 baseline.
  29.  * 
  30.  */
  31.  
  32. #include "EXTERN.h"
  33. #include "perl.h"
  34. #include "perly.h"
  35.  
  36. extern char *tokename[];
  37. extern int yychar;
  38.  
  39. static int cmd_tosave();
  40. static int arg_tosave();
  41. static int spat_tosave();
  42. static void make_cswitch();
  43. static void make_nswitch();
  44.  
  45. static bool saw_return;
  46.  
  47. SUBR *
  48. make_sub(name,cmd)
  49. char *name;
  50. CMD *cmd;
  51. {
  52.     register SUBR *sub;
  53.     STAB *stab = stabent(name,TRUE);
  54.  
  55.     if (sub = stab_sub(stab)) {
  56.     if (dowarn) {
  57.         CMD *oldcurcmd = curcmd;
  58.  
  59.         if (cmd)
  60.         curcmd = cmd;
  61.         warn("Subroutine %s redefined",name);
  62.         curcmd = oldcurcmd;
  63.     }
  64.     if (!sub->usersub && sub->cmd) {
  65.         cmd_free(sub->cmd);
  66.         sub->cmd = Nullcmd;
  67.         afree(sub->tosave);
  68.     }
  69.     Safefree(sub);
  70.     }
  71.     Newz(101,sub,1,SUBR);
  72.     stab_sub(stab) = sub;
  73.     sub->filestab = curcmd->c_filestab;
  74.     saw_return = FALSE;
  75.     tosave = anew(Nullstab);
  76.     tosave->ary_fill = 0;    /* make 1 based */
  77.     (void)cmd_tosave(cmd,FALSE);    /* this builds the tosave array */
  78.     sub->tosave = tosave;
  79.     if (saw_return) {
  80.     struct compcmd mycompblock;
  81.  
  82.     mycompblock.comp_true = cmd;
  83.     mycompblock.comp_alt = Nullcmd;
  84.     cmd = add_label(savestr("_SUB_"),make_ccmd(C_BLOCK,0,
  85.         Nullarg,mycompblock));
  86.     saw_return = FALSE;
  87.     cmd->c_flags |= CF_TERM;
  88.     }
  89.     sub->cmd = cmd;
  90.     if (perldb) {
  91.     STR *str;
  92.     STR *tmpstr = str_mortal(&str_undef);
  93.  
  94.     sprintf(buf,"%s:%ld",stab_val(curcmd->c_filestab)->str_ptr, subline);
  95.     str = str_make(buf,0);
  96.     str_cat(str,"-");
  97.     sprintf(buf,"%ld",(long)curcmd->c_line);
  98.     str_cat(str,buf);
  99.     stab_efullname(tmpstr,stab);
  100.     hstore(stab_xhash(DBsub), tmpstr->str_ptr, tmpstr->str_cur, str, 0);
  101.     }
  102.     Safefree(name);
  103.     return sub;
  104. }
  105.  
  106. SUBR *
  107. make_usub(name, ix, subaddr, filename)
  108. char *name;
  109. int ix;
  110. int (*subaddr)();
  111. char *filename;
  112. {
  113.     register SUBR *sub;
  114.     STAB *stab = stabent(name,allstabs);
  115.  
  116.     if (!stab)                /* unused function */
  117.     return Null(SUBR*);
  118.     if (sub = stab_sub(stab)) {
  119.     if (dowarn)
  120.         warn("Subroutine %s redefined",name);
  121.     if (!sub->usersub && sub->cmd) {
  122.         cmd_free(sub->cmd);
  123.         sub->cmd = Nullcmd;
  124.         afree(sub->tosave);
  125.     }
  126.     Safefree(sub);
  127.     }
  128.     Newz(101,sub,1,SUBR);
  129.     stab_sub(stab) = sub;
  130.     sub->filestab = fstab(filename);
  131.     sub->usersub = subaddr;
  132.     sub->userindex = ix;
  133.     return sub;
  134. }
  135.  
  136. void
  137. make_form(stab,fcmd)
  138. STAB *stab;
  139. FCMD *fcmd;
  140. {
  141.     if (stab_form(stab)) {
  142.     FCMD *tmpfcmd;
  143.     FCMD *nextfcmd;
  144.  
  145.     for (tmpfcmd = stab_form(stab); tmpfcmd; tmpfcmd = nextfcmd) {
  146.         nextfcmd = tmpfcmd->f_next;
  147.         if (tmpfcmd->f_expr)
  148.         arg_free(tmpfcmd->f_expr);
  149.         if (tmpfcmd->f_unparsed)
  150.         str_free(tmpfcmd->f_unparsed);
  151.         if (tmpfcmd->f_pre)
  152.         Safefree(tmpfcmd->f_pre);
  153.         Safefree(tmpfcmd);
  154.     }
  155.     }
  156.     stab_form(stab) = fcmd;
  157. }
  158.  
  159. CMD *
  160. block_head(tail)
  161. register CMD *tail;
  162. {
  163.     CMD *head;
  164.     register int opt;
  165.     register int last_opt = 0;
  166.     register STAB *last_stab = Nullstab;
  167.     register int count = 0;
  168.     register CMD *switchbeg = Nullcmd;
  169.  
  170.     if (tail == Nullcmd) {
  171.     return tail;
  172.     }
  173.     head = tail->c_head;
  174.  
  175.     for (tail = head; tail; tail = tail->c_next) {
  176.  
  177.     /* save one measly dereference at runtime */
  178.     if (tail->c_type == C_IF) {
  179.         if (!(tail->ucmd.ccmd.cc_alt = tail->ucmd.ccmd.cc_alt->c_next))
  180.         tail->c_flags |= CF_TERM;
  181.     }
  182.     else if (tail->c_type == C_EXPR) {
  183.         ARG *arg;
  184.  
  185.         if (tail->ucmd.acmd.ac_expr)
  186.         arg = tail->ucmd.acmd.ac_expr;
  187.         else
  188.         arg = tail->c_expr;
  189.         if (arg) {
  190.         if (arg->arg_type == O_RETURN)
  191.             tail->c_flags |= CF_TERM;
  192.         else if (arg->arg_type == O_ITEM && arg[1].arg_type == A_CMD)
  193.             tail->c_flags |= CF_TERM;
  194.         }
  195.     }
  196.     if (!tail->c_next)
  197.         tail->c_flags |= CF_TERM;
  198.  
  199.     if (tail->c_expr && (tail->c_flags & CF_OPTIMIZE) == CFT_FALSE)
  200.         opt_arg(tail,1, tail->c_type == C_EXPR);
  201.  
  202.     /* now do a little optimization on case-ish structures */
  203.     switch(tail->c_flags & (CF_OPTIMIZE|CF_FIRSTNEG|CF_INVERT)) {
  204.     case CFT_ANCHOR:
  205.     case CFT_STROP:
  206.         opt = (tail->c_flags & CF_NESURE) ? CFT_STROP : 0;
  207.         break;
  208.     case CFT_CCLASS:
  209.         opt = CFT_STROP;
  210.         break;
  211.     case CFT_NUMOP:
  212.         opt = (tail->c_slen == O_NE ? 0 : CFT_NUMOP);
  213.         if ((tail->c_flags&(CF_NESURE|CF_EQSURE)) != (CF_NESURE|CF_EQSURE))
  214.         opt = 0;
  215.         break;
  216.     default:
  217.         opt = 0;
  218.     }
  219.     if (opt && opt == last_opt && tail->c_stab == last_stab)
  220.         count++;
  221.     else {
  222.         if (count >= 3) {        /* is this the breakeven point? */
  223.         if (last_opt == CFT_NUMOP)
  224.             make_nswitch(switchbeg,count);
  225.         else
  226.             make_cswitch(switchbeg,count);
  227.         }
  228.         if (opt) {
  229.         count = 1;
  230.         switchbeg = tail;
  231.         }
  232.         else
  233.         count = 0;
  234.     }
  235.     last_opt = opt;
  236.     last_stab = tail->c_stab;
  237.     }
  238.     if (count >= 3) {        /* is this the breakeven point? */
  239.     if (last_opt == CFT_NUMOP)
  240.         make_nswitch(switchbeg,count);
  241.     else
  242.         make_cswitch(switchbeg,count);
  243.     }
  244.     return head;
  245. }
  246.  
  247. /* We've spotted a sequence of CMDs that all test the value of the same
  248.  * spat.  Thus we can insert a SWITCH in front and jump directly
  249.  * to the correct one.
  250.  */
  251. static void
  252. make_cswitch(head,count)
  253. register CMD *head;
  254. int count;
  255. {
  256.     register CMD *cur;
  257.     register CMD **loc;
  258.     register int i;
  259.     register int min = 255;
  260.     register int max = 0;
  261.  
  262.     /* make a new head in the exact same spot */
  263.     New(102,cur, 1, CMD);
  264.     StructCopy(head,cur,CMD);
  265.     Zero(head,1,CMD);
  266.     head->c_head = cur->c_head;
  267.     head->c_type = C_CSWITCH;
  268.     head->c_next = cur;        /* insert new cmd at front of list */
  269.     head->c_stab = cur->c_stab;
  270.  
  271.     Newz(103,loc,258,CMD*);
  272.     loc++;                /* lie a little */
  273.     while (count--) {
  274.     if ((cur->c_flags & CF_OPTIMIZE) == CFT_CCLASS) {
  275.         for (i = 0; i <= 255; i++) {
  276.         if (!loc[i] && cur->c_short->str_ptr[i>>3] & (1 << (i&7))) {
  277.             loc[i] = cur;
  278.             if (i < min)
  279.             min = i;
  280.             if (i > max)
  281.             max = i;
  282.         }
  283.         }
  284.     }
  285.     else {
  286.         i = *cur->c_short->str_ptr & 255;
  287.         if (!loc[i]) {
  288.         loc[i] = cur;
  289.         if (i < min)
  290.             min = i;
  291.         if (i > max)
  292.             max = i;
  293.         }
  294.     }
  295.     cur = cur->c_next;
  296.     }
  297.     max++;
  298.     if (min > 0)
  299.     Move(&loc[min],&loc[0], max - min, CMD*);
  300.     loc--;
  301.     min--;
  302.     max -= min;
  303.     for (i = 0; i <= max; i++)
  304.     if (!loc[i])
  305.         loc[i] = cur;
  306.     Renew(loc,max+1,CMD*);    /* chop it down to size */
  307.     head->ucmd.scmd.sc_offset = min;
  308.     head->ucmd.scmd.sc_max = max;
  309.     head->ucmd.scmd.sc_next = loc;
  310. }
  311.  
  312. static void
  313. make_nswitch(head,count)
  314. register CMD *head;
  315. int count;
  316. {
  317.     register CMD *cur = head;
  318.     register CMD **loc;
  319.     register int i;
  320.     register int min = 32767;
  321.     register int max = -32768;
  322.     int origcount = count;
  323.     double value;        /* or your money back! */
  324.     short changed;        /* so triple your money back! */
  325.  
  326.     while (count--) {
  327.     i = (int)str_gnum(cur->c_short);
  328.     value = (double)i;
  329.     if (value != cur->c_short->str_u.str_nval)
  330.         return;        /* fractional values--just forget it */
  331.     changed = i;
  332.     if (changed != i)
  333.         return;        /* too big for a short */
  334.     if (cur->c_slen == O_LE)
  335.         i++;
  336.     else if (cur->c_slen == O_GE)    /* we only do < or > here */
  337.         i--;
  338.     if (i < min)
  339.         min = i;
  340.     if (i > max)
  341.         max = i;
  342.     cur = cur->c_next;
  343.     }
  344.     count = origcount;
  345.     if (max - min > count * 2 + 10)        /* too sparse? */
  346.     return;
  347.  
  348.     /* now make a new head in the exact same spot */
  349.     New(104,cur, 1, CMD);
  350.     StructCopy(head,cur,CMD);
  351.     Zero(head,1,CMD);
  352.     head->c_head = cur->c_head;
  353.     head->c_type = C_NSWITCH;
  354.     head->c_next = cur;        /* insert new cmd at front of list */
  355.     head->c_stab = cur->c_stab;
  356.  
  357.     Newz(105,loc, max - min + 3, CMD*);
  358.     loc++;
  359.     max -= min;
  360.     max++;
  361.     while (count--) {
  362.     i = (int)str_gnum(cur->c_short);
  363.     i -= min;
  364.     switch(cur->c_slen) {
  365.     case O_LE:
  366.         i++;
  367.     case O_LT:
  368.         for (i--; i >= -1; i--)
  369.         if (!loc[i])
  370.             loc[i] = cur;
  371.         break;
  372.     case O_GE:
  373.         i--;
  374.     case O_GT:
  375.         for (i++; i <= max; i++)
  376.         if (!loc[i])
  377.             loc[i] = cur;
  378.         break;
  379.     case O_EQ:
  380.         if (!loc[i])
  381.         loc[i] = cur;
  382.         break;
  383.     }
  384.     cur = cur->c_next;
  385.     }
  386.     loc--;
  387.     min--;
  388.     max++;
  389.     for (i = 0; i <= max; i++)
  390.     if (!loc[i])
  391.         loc[i] = cur;
  392.     head->ucmd.scmd.sc_offset = min;
  393.     head->ucmd.scmd.sc_max = max;
  394.     head->ucmd.scmd.sc_next = loc;
  395. }
  396.  
  397. CMD *
  398. append_line(head,tail)
  399. register CMD *head;
  400. register CMD *tail;
  401. {
  402.     if (tail == Nullcmd)
  403.     return head;
  404.     if (!tail->c_head)            /* make sure tail is well formed */
  405.     tail->c_head = tail;
  406.     if (head != Nullcmd) {
  407.     tail = tail->c_head;        /* get to start of tail list */
  408.     if (!head->c_head)
  409.         head->c_head = head;    /* start a new head list */
  410.     while (head->c_next) {
  411.         head->c_next->c_head = head->c_head;
  412.         head = head->c_next;    /* get to end of head list */
  413.     }
  414.     head->c_next = tail;        /* link to end of old list */
  415.     tail->c_head = head->c_head;    /* propagate head pointer */
  416.     }
  417.     while (tail->c_next) {
  418.     tail->c_next->c_head = tail->c_head;
  419.     tail = tail->c_next;
  420.     }
  421.     return tail;
  422. }
  423.  
  424. CMD *
  425. dodb(cur)
  426. CMD *cur;
  427. {
  428.     register CMD *cmd;
  429.     register CMD *head = cur->c_head;
  430.     STR *str;
  431.  
  432.     if (!head)
  433.     head = cur;
  434.     if (!head->c_line)
  435.     return cur;
  436.     str = afetch(stab_xarray(curcmd->c_filestab),(int)head->c_line,FALSE);
  437.     if (str == &str_undef || str->str_nok)
  438.     return cur;
  439.     str->str_u.str_nval = (double)head->c_line;
  440.     str->str_nok = 1;
  441.     Newz(106,cmd,1,CMD);
  442.     str_magic(str, curcmd->c_filestab, 0, Nullch, 0);
  443.     str->str_magic->str_u.str_cmd = cmd;
  444.     cmd->c_type = C_EXPR;
  445.     cmd->ucmd.acmd.ac_stab = Nullstab;
  446.     cmd->ucmd.acmd.ac_expr = Nullarg;
  447.     cmd->c_expr = make_op(O_SUBR, 2,
  448.     stab2arg(A_WORD,DBstab),
  449.     Nullarg,
  450.     Nullarg);
  451.     /*SUPPRESS 53*/
  452.     cmd->c_flags |= CF_COND|CF_DBSUB|CFT_D0;
  453.     cmd->c_line = head->c_line;
  454.     cmd->c_label = head->c_label;
  455.     cmd->c_filestab = curcmd->c_filestab;
  456.     cmd->c_stash = curstash;
  457.     return append_line(cmd, cur);
  458. }
  459.  
  460. CMD *
  461. make_acmd(type,stab,cond,arg)
  462. int type;
  463. STAB *stab;
  464. ARG *cond;
  465. ARG *arg;
  466. {
  467.     register CMD *cmd;
  468.  
  469.     Newz(107,cmd,1,CMD);
  470.     cmd->c_type = type;
  471.     cmd->ucmd.acmd.ac_stab = stab;
  472.     cmd->ucmd.acmd.ac_expr = arg;
  473.     cmd->c_expr = cond;
  474.     if (cond)
  475.     cmd->c_flags |= CF_COND;
  476.     if (cmdline == NOLINE)
  477.     cmd->c_line = curcmd->c_line;
  478.     else {
  479.     cmd->c_line = cmdline;
  480.     cmdline = NOLINE;
  481.     }
  482.     cmd->c_filestab = curcmd->c_filestab;
  483.     cmd->c_stash = curstash;
  484.     if (perldb)
  485.     cmd = dodb(cmd);
  486.     return cmd;
  487. }
  488.  
  489. CMD *
  490. make_ccmd(type,debuggable,arg,cblock)
  491. int type;
  492. int debuggable;
  493. ARG *arg;
  494. struct compcmd cblock;
  495. {
  496.     register CMD *cmd;
  497.  
  498.     Newz(108,cmd, 1, CMD);
  499.     cmd->c_type = type;
  500.     cmd->c_expr = arg;
  501.     cmd->ucmd.ccmd.cc_true = cblock.comp_true;
  502.     cmd->ucmd.ccmd.cc_alt = cblock.comp_alt;
  503.     if (arg)
  504.     cmd->c_flags |= CF_COND;
  505.     if (cmdline == NOLINE)
  506.     cmd->c_line = curcmd->c_line;
  507.     else {
  508.     cmd->c_line = cmdline;
  509.     cmdline = NOLINE;
  510.     }
  511.     cmd->c_filestab = curcmd->c_filestab;
  512.     cmd->c_stash = curstash;
  513.     if (perldb && debuggable)
  514.     cmd = dodb(cmd);
  515.     return cmd;
  516. }
  517.  
  518. CMD *
  519. make_icmd(type,arg,cblock)
  520. int type;
  521. ARG *arg;
  522. struct compcmd cblock;
  523. {
  524.     register CMD *cmd;
  525.     register CMD *alt;
  526.     register CMD *cur;
  527.     register CMD *head;
  528.     struct compcmd ncblock;
  529.  
  530.     Newz(109,cmd, 1, CMD);
  531.     head = cmd;
  532.     cmd->c_type = type;
  533.     cmd->c_expr = arg;
  534.     cmd->ucmd.ccmd.cc_true = cblock.comp_true;
  535.     cmd->ucmd.ccmd.cc_alt = cblock.comp_alt;
  536.     if (arg)
  537.     cmd->c_flags |= CF_COND;
  538.     if (cmdline == NOLINE)
  539.     cmd->c_line = curcmd->c_line;
  540.     else {
  541.     cmd->c_line = cmdline;
  542.     cmdline = NOLINE;
  543.     }
  544.     cmd->c_filestab = curcmd->c_filestab;
  545.     cmd->c_stash = curstash;
  546.     cur = cmd;
  547.     alt = cblock.comp_alt;
  548.     while (alt && alt->c_type == C_ELSIF) {
  549.     cur = alt;
  550.     alt = alt->ucmd.ccmd.cc_alt;
  551.     }
  552.     if (alt) {            /* a real life ELSE at the end? */
  553.     ncblock.comp_true = alt;
  554.     ncblock.comp_alt = Nullcmd;
  555.     alt = append_line(cur,make_ccmd(C_ELSE,1,Nullarg,ncblock));
  556.     cur->ucmd.ccmd.cc_alt = alt;
  557.     }
  558.     else
  559.     alt = cur;        /* no ELSE, so cur is proxy ELSE */
  560.  
  561.     cur = cmd;
  562.     while (cmd) {        /* now point everyone at the ELSE */
  563.     cur = cmd;
  564.     cmd = cur->ucmd.ccmd.cc_alt;
  565.     cur->c_head = head;
  566.     if (cur->c_type == C_ELSIF)
  567.         cur->c_type = C_IF;
  568.     if (cur->c_type == C_IF)
  569.         cur->ucmd.ccmd.cc_alt = alt;
  570.     if (cur == alt)
  571.         break;
  572.     cur->c_next = cmd;
  573.     }
  574.     if (perldb)
  575.     cur = dodb(cur);
  576.     return cur;
  577. }
  578.  
  579. void
  580. opt_arg(cmd,fliporflop,acmd)
  581. register CMD *cmd;
  582. int fliporflop;
  583. int acmd;
  584. {
  585.     register ARG *arg;
  586.     int opt = CFT_EVAL;
  587.     int sure = 0;
  588.     ARG *arg2;
  589.     int context = 0;    /* 0 = normal, 1 = before &&, 2 = before || */
  590.     int flp = fliporflop;
  591.  
  592.     if (!cmd)
  593.     return;
  594.     if (!(arg = cmd->c_expr)) {
  595.     cmd->c_flags &= ~CF_COND;
  596.     return;
  597.     }
  598.  
  599.     /* Can we turn && and || into if and unless? */
  600.  
  601.     if (acmd && !cmd->ucmd.acmd.ac_expr && !(cmd->c_flags & CF_TERM) &&
  602.       (arg->arg_type == O_AND || arg->arg_type == O_OR) ) {
  603.     dehoist(arg,1);
  604.     arg[2].arg_type &= A_MASK;    /* don't suppress eval */
  605.     dehoist(arg,2);
  606.     cmd->ucmd.acmd.ac_expr = arg[2].arg_ptr.arg_arg;
  607.     cmd->c_expr = arg[1].arg_ptr.arg_arg;
  608.     if (arg->arg_type == O_OR)
  609.         cmd->c_flags ^= CF_INVERT;        /* || is like unless */
  610.     arg->arg_len = 0;
  611.     free_arg(arg);
  612.     arg = cmd->c_expr;
  613.     }
  614.  
  615.     /* Turn "if (!expr)" into "unless (expr)" */
  616.  
  617.     if (!(cmd->c_flags & CF_TERM)) {        /* unless return value wanted */
  618.     while (arg->arg_type == O_NOT) {
  619.         dehoist(arg,1);
  620.         cmd->c_flags ^= CF_INVERT;        /* flip sense of cmd */
  621.         cmd->c_expr = arg[1].arg_ptr.arg_arg; /* hoist the rest of expr */
  622.         free_arg(arg);
  623.         arg = cmd->c_expr;            /* here we go again */
  624.     }
  625.     }
  626.  
  627.     if (!arg->arg_len) {        /* sanity check */
  628.     cmd->c_flags |= opt;
  629.     return;
  630.     }
  631.  
  632.     /* for "cond .. cond" we set up for the initial check */
  633.  
  634.     if (arg->arg_type == O_FLIP)
  635.     context |= 4;
  636.  
  637.     /* for "cond && expr" and "cond || expr" we can ignore expr, sort of */
  638.  
  639.   morecontext:
  640.     if (arg->arg_type == O_AND)
  641.     context |= 1;
  642.     else if (arg->arg_type == O_OR)
  643.     context |= 2;
  644.     if (context && (arg[flp].arg_type & A_MASK) == A_EXPR) {
  645.     arg = arg[flp].arg_ptr.arg_arg;
  646.     flp = 1;
  647.     if (arg->arg_type == O_AND || arg->arg_type == O_OR)
  648.         goto morecontext;
  649.     }
  650.     if ((context & 3) == 3)
  651.     return;
  652.  
  653.     if (arg[flp].arg_flags & (AF_PRE|AF_POST)) {
  654.     cmd->c_flags |= opt;
  655.     if (acmd && !cmd->ucmd.acmd.ac_expr && !(cmd->c_flags & CF_TERM)
  656.       && cmd->c_expr->arg_type == O_ITEM) {
  657.         arg[flp].arg_flags &= ~AF_POST;    /* prefer ++$foo to $foo++ */
  658.         arg[flp].arg_flags |= AF_PRE;    /*  if value not wanted */
  659.     }
  660.     return;                /* side effect, can't optimize */
  661.     }
  662.  
  663.     if (arg->arg_type == O_ITEM || arg->arg_type == O_FLIP ||
  664.       arg->arg_type == O_AND || arg->arg_type == O_OR) {
  665.     if ((arg[flp].arg_type & A_MASK) == A_SINGLE) {
  666.         opt = (str_true(arg[flp].arg_ptr.arg_str) ? CFT_TRUE : CFT_FALSE);
  667.         cmd->c_short = str_smake(arg[flp].arg_ptr.arg_str);
  668.         goto literal;
  669.     }
  670.     else if ((arg[flp].arg_type & A_MASK) == A_STAB ||
  671.       (arg[flp].arg_type & A_MASK) == A_LVAL) {
  672.         cmd->c_stab  = arg[flp].arg_ptr.arg_stab;
  673.         if (!context)
  674.         arg[flp].arg_ptr.arg_stab = Nullstab;
  675.         opt = CFT_REG;
  676.       literal:
  677.         if (!context) {    /* no && or ||? */
  678.         arg_free(arg);
  679.         cmd->c_expr = Nullarg;
  680.         }
  681.         if (!(context & 1))
  682.         cmd->c_flags |= CF_EQSURE;
  683.         if (!(context & 2))
  684.         cmd->c_flags |= CF_NESURE;
  685.     }
  686.     }
  687.     else if (arg->arg_type == O_MATCH || arg->arg_type == O_SUBST ||
  688.          arg->arg_type == O_NMATCH || arg->arg_type == O_NSUBST) {
  689.     if ((arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) &&
  690.         (arg[2].arg_type & A_MASK) == A_SPAT &&
  691.         arg[2].arg_ptr.arg_spat->spat_short &&
  692.         (arg->arg_type == O_SUBST || arg->arg_type == O_NSUBST ||
  693.          (arg[2].arg_ptr.arg_spat->spat_flags & SPAT_GLOBAL) == 0 )) {
  694.         cmd->c_stab  = arg[1].arg_ptr.arg_stab;
  695.         cmd->c_short = str_smake(arg[2].arg_ptr.arg_spat->spat_short);
  696.         cmd->c_slen  = arg[2].arg_ptr.arg_spat->spat_slen;
  697.         if (arg[2].arg_ptr.arg_spat->spat_flags & SPAT_ALL &&
  698.         !(arg[2].arg_ptr.arg_spat->spat_flags & SPAT_ONCE) &&
  699.         (arg->arg_type == O_MATCH || arg->arg_type == O_NMATCH) )
  700.         sure |= CF_EQSURE;        /* (SUBST must be forced even */
  701.                         /* if we know it will work.) */
  702.         if (arg->arg_type != O_SUBST) {
  703.         str_free(arg[2].arg_ptr.arg_spat->spat_short);
  704.         arg[2].arg_ptr.arg_spat->spat_short = Nullstr;
  705.         arg[2].arg_ptr.arg_spat->spat_slen = 0; /* only one chk */
  706.         }
  707.         sure |= CF_NESURE;        /* normally only sure if it fails */
  708.         if (arg->arg_type == O_NMATCH || arg->arg_type == O_NSUBST)
  709.         cmd->c_flags |= CF_FIRSTNEG;
  710.         if (context & 1) {        /* only sure if thing is false */
  711.         if (cmd->c_flags & CF_FIRSTNEG)
  712.             sure &= ~CF_NESURE;
  713.         else
  714.             sure &= ~CF_EQSURE;
  715.         }
  716.         else if (context & 2) {    /* only sure if thing is true */
  717.         if (cmd->c_flags & CF_FIRSTNEG)
  718.             sure &= ~CF_EQSURE;
  719.         else
  720.             sure &= ~CF_NESURE;
  721.         }
  722.         if (sure & (CF_EQSURE|CF_NESURE)) {    /* if we know anything*/
  723.         if (arg[2].arg_ptr.arg_spat->spat_flags & SPAT_SCANFIRST)
  724.             opt = CFT_SCAN;
  725.         else
  726.             opt = CFT_ANCHOR;
  727.         if (sure == (CF_EQSURE|CF_NESURE)    /* really sure? */
  728.             && arg->arg_type == O_MATCH
  729.             && context & 4
  730.             && fliporflop == 1) {
  731.             spat_free(arg[2].arg_ptr.arg_spat);
  732.             arg[2].arg_ptr.arg_spat = Nullspat;    /* don't do twice */
  733.         }
  734.         else
  735.             cmd->c_spat = arg[2].arg_ptr.arg_spat;
  736.         cmd->c_flags |= sure;
  737.         }
  738.     }
  739.     }
  740.     else if (arg->arg_type == O_SEQ || arg->arg_type == O_SNE ||
  741.          arg->arg_type == O_SLT || arg->arg_type == O_SGT) {
  742.     if (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) {
  743.         if (arg[2].arg_type == A_SINGLE) {
  744.         /*SUPPRESS 594*/
  745.         char *junk = str_get(arg[2].arg_ptr.arg_str);
  746.  
  747.         cmd->c_stab  = arg[1].arg_ptr.arg_stab;
  748.         cmd->c_short = str_smake(arg[2].arg_ptr.arg_str);
  749.         cmd->c_slen  = cmd->c_short->str_cur+1;
  750.         switch (arg->arg_type) {
  751.         case O_SLT: case O_SGT:
  752.             sure |= CF_EQSURE;
  753.             cmd->c_flags |= CF_FIRSTNEG;
  754.             break;
  755.         case O_SNE:
  756.             cmd->c_flags |= CF_FIRSTNEG;
  757.             /* FALL THROUGH */
  758.         case O_SEQ:
  759.             sure |= CF_NESURE|CF_EQSURE;
  760.             break;
  761.         }
  762.         if (context & 1) {    /* only sure if thing is false */
  763.             if (cmd->c_flags & CF_FIRSTNEG)
  764.             sure &= ~CF_NESURE;
  765.             else
  766.             sure &= ~CF_EQSURE;
  767.         }
  768.         else if (context & 2) { /* only sure if thing is true */
  769.             if (cmd->c_flags & CF_FIRSTNEG)
  770.             sure &= ~CF_EQSURE;
  771.             else
  772.             sure &= ~CF_NESURE;
  773.         }
  774.         if (sure & (CF_EQSURE|CF_NESURE)) {
  775.             opt = CFT_STROP;
  776.             cmd->c_flags |= sure;
  777.         }
  778.         }
  779.     }
  780.     }
  781.     else if (arg->arg_type == O_EQ || arg->arg_type == O_NE ||
  782.          arg->arg_type == O_LE || arg->arg_type == O_GE ||
  783.          arg->arg_type == O_LT || arg->arg_type == O_GT) {
  784.     if (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) {
  785.         if (arg[2].arg_type == A_SINGLE) {
  786.         cmd->c_stab  = arg[1].arg_ptr.arg_stab;
  787.         if (dowarn) {
  788.             STR *str = arg[2].arg_ptr.arg_str;
  789.  
  790.             if ((!str->str_nok && !looks_like_number(str)))
  791.             warn("Possible use of == on string value");
  792.         }
  793.         cmd->c_short = str_nmake(str_gnum(arg[2].arg_ptr.arg_str));
  794.         cmd->c_slen = arg->arg_type;
  795.         sure |= CF_NESURE|CF_EQSURE;
  796.         if (context & 1) {    /* only sure if thing is false */
  797.             sure &= ~CF_EQSURE;
  798.         }
  799.         else if (context & 2) { /* only sure if thing is true */
  800.             sure &= ~CF_NESURE;
  801.         }
  802.         if (sure & (CF_EQSURE|CF_NESURE)) {
  803.             opt = CFT_NUMOP;
  804.             cmd->c_flags |= sure;
  805.         }
  806.         }
  807.     }
  808.     }
  809.     else if (arg->arg_type == O_ASSIGN &&
  810.          (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) &&
  811.          arg[1].arg_ptr.arg_stab == defstab &&
  812.          arg[2].arg_type == A_EXPR ) {
  813.     arg2 = arg[2].arg_ptr.arg_arg;
  814.     if (arg2->arg_type == O_ITEM && arg2[1].arg_type == A_READ) {
  815.         opt = CFT_GETS;
  816.         cmd->c_stab = arg2[1].arg_ptr.arg_stab;
  817.         if (!(stab_io(arg2[1].arg_ptr.arg_stab)->flags & IOF_ARGV)) {
  818.         free_arg(arg2);
  819.         arg[2].arg_ptr.arg_arg = Nullarg;
  820.         free_arg(arg);
  821.         cmd->c_expr = Nullarg;
  822.         }
  823.     }
  824.     }
  825.     else if (arg->arg_type == O_CHOP &&
  826.          (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) ) {
  827.     opt = CFT_CHOP;
  828.     cmd->c_stab = arg[1].arg_ptr.arg_stab;
  829.     free_arg(arg);
  830.     cmd->c_expr = Nullarg;
  831.     }
  832.     if (context & 4)
  833.     opt |= CF_FLIP;
  834.     cmd->c_flags |= opt;
  835.  
  836.     if (cmd->c_flags & CF_FLIP) {
  837.     if (fliporflop == 1) {
  838.         arg = cmd->c_expr;    /* get back to O_FLIP arg */
  839.         New(110,arg[3].arg_ptr.arg_cmd, 1, CMD);
  840.         Copy(cmd, arg[3].arg_ptr.arg_cmd, 1, CMD);
  841.         New(111,arg[4].arg_ptr.arg_cmd,1,CMD);
  842.         Copy(cmd, arg[4].arg_ptr.arg_cmd, 1, CMD);
  843.         opt_arg(arg[4].arg_ptr.arg_cmd,2,acmd);
  844.         arg->arg_len = 2;        /* this is a lie */
  845.     }
  846.     else {
  847.         if ((opt & CF_OPTIMIZE) == CFT_EVAL)
  848.         cmd->c_flags = (cmd->c_flags & ~CF_OPTIMIZE) | CFT_UNFLIP;
  849.     }
  850.     }
  851. }
  852.  
  853. CMD *
  854. add_label(lbl,cmd)
  855. char *lbl;
  856. register CMD *cmd;
  857. {
  858.     if (cmd)
  859.     cmd->c_label = lbl;
  860.     return cmd;
  861. }
  862.  
  863. CMD *
  864. addcond(cmd, arg)
  865. register CMD *cmd;
  866. register ARG *arg;
  867. {
  868.     cmd->c_expr = arg;
  869.     cmd->c_flags |= CF_COND;
  870.     return cmd;
  871. }
  872.  
  873. CMD *
  874. addloop(cmd, arg)
  875. register CMD *cmd;
  876. register ARG *arg;
  877. {
  878.     void while_io();
  879.  
  880.     cmd->c_expr = arg;
  881.     cmd->c_flags |= CF_COND|CF_LOOP;
  882.  
  883.     if (!(cmd->c_flags & CF_INVERT))
  884.     while_io(cmd);        /* add $_ =, if necessary */
  885.  
  886.     if (cmd->c_type == C_BLOCK)
  887.     cmd->c_flags &= ~CF_COND;
  888.     else {
  889.     arg = cmd->ucmd.acmd.ac_expr;
  890.     if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_CMD)
  891.         cmd->c_flags &= ~CF_COND;  /* "do {} while" happens at least once */
  892.     if (arg && (arg->arg_flags & AF_DEPR) &&
  893.       (arg->arg_type == O_SUBR || arg->arg_type == O_DBSUBR) )
  894.         cmd->c_flags &= ~CF_COND;  /* likewise for "do subr() while" */
  895.     }
  896.     return cmd;
  897. }
  898.  
  899. CMD *
  900. invert(cmd)
  901. CMD *cmd;
  902. {
  903.     register CMD *targ = cmd;
  904.     if (targ->c_head)
  905.     targ = targ->c_head;
  906.     if (targ->c_flags & CF_DBSUB)
  907.     targ = targ->c_next;
  908.     targ->c_flags ^= CF_INVERT;
  909.     return cmd;
  910. }
  911.  
  912. void
  913. cpy7bit(d,s,l)
  914. register char *d;
  915. register char *s;
  916. register int l;
  917. {
  918.     while (l--)
  919.     *d++ = *s++ & 127;
  920.     *d = '\0';
  921. }
  922.  
  923. int
  924. yyerror(s)
  925. char *s;
  926. {
  927.     char tmpbuf[258];
  928.     char tmp2buf[258];
  929.     char *tname = tmpbuf;
  930.  
  931.     if (bufptr > oldoldbufptr && bufptr - oldoldbufptr < 200 &&
  932.       oldoldbufptr != oldbufptr && oldbufptr != bufptr) {
  933.     while (isSPACE(*oldoldbufptr))
  934.         oldoldbufptr++;
  935.     cpy7bit(tmp2buf, oldoldbufptr, bufptr - oldoldbufptr);
  936.     sprintf(tname,"next 2 tokens \"%s\"",tmp2buf);
  937.     }
  938.     else if (bufptr > oldbufptr && bufptr - oldbufptr < 200 &&
  939.       oldbufptr != bufptr) {
  940.     while (isSPACE(*oldbufptr))
  941.         oldbufptr++;
  942.     cpy7bit(tmp2buf, oldbufptr, bufptr - oldbufptr);
  943.     sprintf(tname,"next token \"%s\"",tmp2buf);
  944.     }
  945.     else if (yychar > 256)
  946.     tname = "next token ???";
  947.     else if (!yychar)
  948.     (void)strcpy(tname,"at EOF");
  949.     else if (yychar < 32)
  950.     (void)sprintf(tname,"next char ^%c",yychar+64);
  951.     else if (yychar == 127)
  952.     (void)strcpy(tname,"at EOF");
  953.     else
  954.     (void)sprintf(tname,"next char %c",yychar);
  955.     (void)sprintf(buf, "%s in file %s at line %d, %s\n",
  956.       s,stab_val(curcmd->c_filestab)->str_ptr,curcmd->c_line,tname);
  957.     if (curcmd->c_line == multi_end && multi_start < multi_end)
  958.     sprintf(buf+strlen(buf),
  959.       "  (Might be a runaway multi-line %c%c string starting on line %d)\n",
  960.       multi_open,multi_close,multi_start);
  961.     if (in_eval)
  962.     str_cat(stab_val(stabent("@",TRUE)),buf);
  963.     else
  964.     fputs(buf,stderr);
  965.     if (++error_count >= 10)
  966.     fatal("%s has too many errors.\n",
  967.     stab_val(curcmd->c_filestab)->str_ptr);
  968. }
  969.  
  970. void
  971. while_io(cmd)
  972. register CMD *cmd;
  973. {
  974.     register ARG *arg = cmd->c_expr;
  975.     STAB *asgnstab;
  976.  
  977.     /* hoist "while (<channel>)" up into command block */
  978.  
  979.     if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_READ) {
  980.     cmd->c_flags &= ~CF_OPTIMIZE;    /* clear optimization type */
  981.     cmd->c_flags |= CFT_GETS;    /* and set it to do the input */
  982.     cmd->c_stab = arg[1].arg_ptr.arg_stab;
  983.     if (stab_io(arg[1].arg_ptr.arg_stab)->flags & IOF_ARGV) {
  984.         cmd->c_expr = l(make_op(O_ASSIGN, 2,    /* fake up "$_ =" */
  985.            stab2arg(A_LVAL,defstab), arg, Nullarg));
  986.     }
  987.     else {
  988.         free_arg(arg);
  989.         cmd->c_expr = Nullarg;
  990.     }
  991.     }
  992.     else if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_INDREAD) {
  993.     cmd->c_flags &= ~CF_OPTIMIZE;    /* clear optimization type */
  994.     cmd->c_flags |= CFT_INDGETS;    /* and set it to do the input */
  995.     cmd->c_stab = arg[1].arg_ptr.arg_stab;
  996.     free_arg(arg);
  997.     cmd->c_expr = Nullarg;
  998.     }
  999.     else if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_GLOB) {
  1000.     if ((cmd->c_flags & CF_OPTIMIZE) == CFT_ARRAY)
  1001.         asgnstab = cmd->c_stab;
  1002.     else
  1003.         asgnstab = defstab;
  1004.     cmd->c_expr = l(make_op(O_ASSIGN, 2,    /* fake up "$foo =" */
  1005.        stab2arg(A_LVAL,asgnstab), arg, Nullarg));
  1006.     cmd->c_flags &= ~CF_OPTIMIZE;    /* clear optimization type */
  1007.     }
  1008. }
  1009.  
  1010. CMD *
  1011. wopt(cmd)
  1012. register CMD *cmd;
  1013. {
  1014.     register CMD *tail;
  1015.     CMD *newtail;
  1016.     register int i;
  1017.  
  1018.     if (cmd->c_expr && (cmd->c_flags & CF_OPTIMIZE) == CFT_FALSE)
  1019.     opt_arg(cmd,1, cmd->c_type == C_EXPR);
  1020.  
  1021.     while_io(cmd);        /* add $_ =, if necessary */
  1022.  
  1023.     /* First find the end of the true list */
  1024.  
  1025.     tail = cmd->ucmd.ccmd.cc_true;
  1026.     if (tail == Nullcmd)
  1027.     return cmd;
  1028.     New(112,newtail, 1, CMD);    /* guaranteed continue */
  1029.     for (;;) {
  1030.     /* optimize "next" to point directly to continue block */
  1031.     if (tail->c_type == C_EXPR &&
  1032.         tail->ucmd.acmd.ac_expr &&
  1033.         tail->ucmd.acmd.ac_expr->arg_type == O_NEXT &&
  1034.         (tail->ucmd.acmd.ac_expr->arg_len == 0 ||
  1035.          (cmd->c_label &&
  1036.           strEQ(cmd->c_label,
  1037.             tail->ucmd.acmd.ac_expr[1].arg_ptr.arg_str->str_ptr) )))
  1038.     {
  1039.         arg_free(tail->ucmd.acmd.ac_expr);
  1040.         tail->ucmd.acmd.ac_expr = Nullarg;
  1041.         tail->c_type = C_NEXT;
  1042.         if (cmd->ucmd.ccmd.cc_alt != Nullcmd)
  1043.         tail->ucmd.ccmd.cc_alt = cmd->ucmd.ccmd.cc_alt;
  1044.         else
  1045.         tail->ucmd.ccmd.cc_alt = newtail;
  1046.         tail->ucmd.ccmd.cc_true = Nullcmd;
  1047.     }
  1048.     else if (tail->c_type == C_IF && !tail->ucmd.ccmd.cc_alt) {
  1049.         if (cmd->ucmd.ccmd.cc_alt != Nullcmd)
  1050.         tail->ucmd.ccmd.cc_alt = cmd->ucmd.ccmd.cc_alt;
  1051.         else
  1052.         tail->ucmd.ccmd.cc_alt = newtail;
  1053.     }
  1054.     else if (tail->c_type == C_CSWITCH || tail->c_type == C_NSWITCH) {
  1055.         if (cmd->ucmd.ccmd.cc_alt != Nullcmd) {
  1056.         for (i = tail->ucmd.scmd.sc_max; i >= 0; i--)
  1057.             if (!tail->ucmd.scmd.sc_next[i])
  1058.             tail->ucmd.scmd.sc_next[i] = cmd->ucmd.ccmd.cc_alt;
  1059.         }
  1060.         else {
  1061.         for (i = tail->ucmd.scmd.sc_max; i >= 0; i--)
  1062.             if (!tail->ucmd.scmd.sc_next[i])
  1063.             tail->ucmd.scmd.sc_next[i] = newtail;
  1064.         }
  1065.     }
  1066.  
  1067.     if (!tail->c_next)
  1068.         break;
  1069.     tail = tail->c_next;
  1070.     }
  1071.  
  1072.     /* if there's a continue block, link it to true block and find end */
  1073.  
  1074.     if (cmd->ucmd.ccmd.cc_alt != Nullcmd) {
  1075.     tail->c_next = cmd->ucmd.ccmd.cc_alt;
  1076.     tail = tail->c_next;
  1077.     for (;;) {
  1078.         /* optimize "next" to point directly to continue block */
  1079.         if (tail->c_type == C_EXPR &&
  1080.         tail->ucmd.acmd.ac_expr &&
  1081.         tail->ucmd.acmd.ac_expr->arg_type == O_NEXT &&
  1082.         (tail->ucmd.acmd.ac_expr->arg_len == 0 ||
  1083.          (cmd->c_label &&
  1084.           strEQ(cmd->c_label,
  1085.             tail->ucmd.acmd.ac_expr[1].arg_ptr.arg_str->str_ptr) )))
  1086.         {
  1087.         arg_free(tail->ucmd.acmd.ac_expr);
  1088.         tail->ucmd.acmd.ac_expr = Nullarg;
  1089.         tail->c_type = C_NEXT;
  1090.         tail->ucmd.ccmd.cc_alt = newtail;
  1091.         tail->ucmd.ccmd.cc_true = Nullcmd;
  1092.         }
  1093.         else if (tail->c_type == C_IF && !tail->ucmd.ccmd.cc_alt) {
  1094.         tail->ucmd.ccmd.cc_alt = newtail;
  1095.         }
  1096.         else if (tail->c_type == C_CSWITCH || tail->c_type == C_NSWITCH) {
  1097.         for (i = tail->ucmd.scmd.sc_max; i >= 0; i--)
  1098.             if (!tail->ucmd.scmd.sc_next[i])
  1099.             tail->ucmd.scmd.sc_next[i] = newtail;
  1100.         }
  1101.  
  1102.         if (!tail->c_next)
  1103.         break;
  1104.         tail = tail->c_next;
  1105.     }
  1106.     /*SUPPRESS 530*/
  1107.     for ( ; tail->c_next; tail = tail->c_next) ;
  1108.     }
  1109.  
  1110.     /* Here's the real trick: link the end of the list back to the beginning,
  1111.      * inserting a "last" block to break out of the loop.  This saves one or
  1112.      * two procedure calls every time through the loop, because of how cmd_exec
  1113.      * does tail recursion.
  1114.      */
  1115.  
  1116.     tail->c_next = newtail;
  1117.     tail = newtail;
  1118.     if (!cmd->ucmd.ccmd.cc_alt)
  1119.     cmd->ucmd.ccmd.cc_alt = tail;    /* every loop has a continue now */
  1120.  
  1121. #ifndef lint
  1122.     Copy((char *)cmd, (char *)tail, 1, CMD);
  1123. #endif
  1124.     tail->c_type = C_EXPR;
  1125.     tail->c_flags ^= CF_INVERT;        /* turn into "last unless" */
  1126.     tail->c_next = tail->ucmd.ccmd.cc_true;    /* loop directly back to top */
  1127.     tail->ucmd.acmd.ac_expr = make_op(O_LAST,0,Nullarg,Nullarg,Nullarg);
  1128.     tail->ucmd.acmd.ac_stab = Nullstab;
  1129.     return cmd;
  1130. }
  1131.  
  1132. CMD *
  1133. over(eachstab,cmd)
  1134. STAB *eachstab;
  1135. register CMD *cmd;
  1136. {
  1137.     /* hoist "for $foo (@bar)" up into command block */
  1138.  
  1139.     cmd->c_flags &= ~CF_OPTIMIZE;    /* clear optimization type */
  1140.     cmd->c_flags |= CFT_ARRAY;        /* and set it to do the iteration */
  1141.     cmd->c_stab = eachstab;
  1142.     cmd->c_short = Str_new(23,0);    /* just to save a field in struct cmd */
  1143.     cmd->c_short->str_u.str_useful = -1;
  1144.  
  1145.     return cmd;
  1146. }
  1147.  
  1148. void
  1149. cmd_free(cmd)
  1150. register CMD *cmd;
  1151. {
  1152.     register CMD *tofree;
  1153.     register CMD *head = cmd;
  1154.  
  1155.     if (!cmd)
  1156.     return;
  1157.     if (cmd->c_head != cmd)
  1158.     warn("Malformed cmd links\n");
  1159.     while (cmd) {
  1160.     if (cmd->c_type != C_WHILE) {    /* WHILE block is duplicated */
  1161.         if (cmd->c_label) {
  1162.         Safefree(cmd->c_label);
  1163.         cmd->c_label = Nullch;
  1164.         }
  1165.         if (cmd->c_short) {
  1166.         str_free(cmd->c_short);
  1167.         cmd->c_short = Nullstr;
  1168.         }
  1169.         if (cmd->c_expr) {
  1170.         arg_free(cmd->c_expr);
  1171.         cmd->c_expr = Nullarg;
  1172.         }
  1173.     }
  1174.     switch (cmd->c_type) {
  1175.     case C_WHILE:
  1176.     case C_BLOCK:
  1177.     case C_ELSE:
  1178.     case C_IF:
  1179.         if (cmd->ucmd.ccmd.cc_true) {
  1180.         cmd_free(cmd->ucmd.ccmd.cc_true);
  1181.         cmd->ucmd.ccmd.cc_true = Nullcmd;
  1182.         }
  1183.         break;
  1184.     case C_EXPR:
  1185.         if (cmd->ucmd.acmd.ac_expr) {
  1186.         arg_free(cmd->ucmd.acmd.ac_expr);
  1187.         cmd->ucmd.acmd.ac_expr = Nullarg;
  1188.         }
  1189.         break;
  1190.     }
  1191.     tofree = cmd;
  1192.     cmd = cmd->c_next;
  1193.     if (tofree != head)        /* to get Saber to shut up */
  1194.         Safefree(tofree);
  1195.     if (cmd && cmd == head)        /* reached end of while loop */
  1196.         break;
  1197.     }
  1198.     Safefree(head);
  1199. }
  1200.  
  1201. void
  1202. arg_free(arg)
  1203. register ARG *arg;
  1204. {
  1205.     register int i;
  1206.  
  1207.     if (!arg)
  1208.     return;
  1209.     for (i = 1; i <= arg->arg_len; i++) {
  1210.     switch (arg[i].arg_type & A_MASK) {
  1211.     case A_NULL:
  1212.         if (arg->arg_type == O_TRANS) {
  1213.         Safefree(arg[i].arg_ptr.arg_cval);
  1214.         arg[i].arg_ptr.arg_cval = Nullch;
  1215.         }
  1216.         break;
  1217.     case A_LEXPR:
  1218.         if (arg->arg_type == O_AASSIGN &&
  1219.           arg[i].arg_ptr.arg_arg->arg_type == O_LARRAY) {
  1220.         char *name = 
  1221.           stab_name(arg[i].arg_ptr.arg_arg[1].arg_ptr.arg_stab);
  1222.  
  1223.         if (strnEQ("_GEN_",name, 5))    /* array for foreach */
  1224.             hdelete(defstash,name,strlen(name));
  1225.         }
  1226.         /* FALL THROUGH */
  1227.     case A_EXPR:
  1228.         arg_free(arg[i].arg_ptr.arg_arg);
  1229.         arg[i].arg_ptr.arg_arg = Nullarg;
  1230.         break;
  1231.     case A_CMD:
  1232.         cmd_free(arg[i].arg_ptr.arg_cmd);
  1233.         arg[i].arg_ptr.arg_cmd = Nullcmd;
  1234.         break;
  1235.     case A_WORD:
  1236.     case A_STAB:
  1237.     case A_LVAL:
  1238.     case A_READ:
  1239.     case A_GLOB:
  1240.     case A_ARYLEN:
  1241.     case A_LARYLEN:
  1242.     case A_ARYSTAB:
  1243.     case A_LARYSTAB:
  1244.         break;
  1245.     case A_SINGLE:
  1246.     case A_DOUBLE:
  1247.     case A_BACKTICK:
  1248.         str_free(arg[i].arg_ptr.arg_str);
  1249.         arg[i].arg_ptr.arg_str = Nullstr;
  1250.         break;
  1251.     case A_SPAT:
  1252.         spat_free(arg[i].arg_ptr.arg_spat);
  1253.         arg[i].arg_ptr.arg_spat = Nullspat;
  1254.         break;
  1255.     }
  1256.     }
  1257.     free_arg(arg);
  1258. }
  1259.  
  1260. void
  1261. spat_free(spat)
  1262. register SPAT *spat;
  1263. {
  1264.     register SPAT *sp;
  1265.     HENT *entry;
  1266.  
  1267.     if (!spat)
  1268.     return;
  1269.     if (spat->spat_runtime) {
  1270.     arg_free(spat->spat_runtime);
  1271.     spat->spat_runtime = Nullarg;
  1272.     }
  1273.     if (spat->spat_repl) {
  1274.     arg_free(spat->spat_repl);
  1275.     spat->spat_repl = Nullarg;
  1276.     }
  1277.     if (spat->spat_short) {
  1278.     str_free(spat->spat_short);
  1279.     spat->spat_short = Nullstr;
  1280.     }
  1281.     if (spat->spat_regexp) {
  1282.     regfree(spat->spat_regexp);
  1283.     spat->spat_regexp = Null(REGEXP*);
  1284.     }
  1285.  
  1286.     /* now unlink from spat list */
  1287.  
  1288.     for (entry = defstash->tbl_array['_']; entry; entry = entry->hent_next) {
  1289.     register HASH *stash;
  1290.     STAB *stab = (STAB*)entry->hent_val;
  1291.  
  1292.     if (!stab)
  1293.         continue;
  1294.     stash = stab_hash(stab);
  1295.     if (!stash || stash->tbl_spatroot == Null(SPAT*))
  1296.         continue;
  1297.     if (stash->tbl_spatroot == spat)
  1298.         stash->tbl_spatroot = spat->spat_next;
  1299.     else {
  1300.         for (sp = stash->tbl_spatroot;
  1301.           sp && sp->spat_next != spat;
  1302.           sp = sp->spat_next)
  1303.         /*SUPPRESS 530*/
  1304.         ;
  1305.         if (sp)
  1306.         sp->spat_next = spat->spat_next;
  1307.     }
  1308.     }
  1309.     Safefree(spat);
  1310. }
  1311.  
  1312. /* Recursively descend a command sequence and push the address of any string
  1313.  * that needs saving on recursion onto the tosave array.
  1314.  */
  1315.  
  1316. static int
  1317. cmd_tosave(cmd,willsave)
  1318. register CMD *cmd;
  1319. int willsave;                /* willsave passes down the tree */
  1320. {
  1321.     register CMD *head = cmd;
  1322.     int shouldsave = FALSE;        /* shouldsave passes up the tree */
  1323.     int tmpsave;
  1324.     register CMD *lastcmd = Nullcmd;
  1325.  
  1326.     while (cmd) {
  1327.     if (cmd->c_expr)
  1328.         shouldsave |= arg_tosave(cmd->c_expr,willsave);
  1329.     switch (cmd->c_type) {
  1330.     case C_WHILE:
  1331.         if (cmd->ucmd.ccmd.cc_true) {
  1332.         tmpsave = cmd_tosave(cmd->ucmd.ccmd.cc_true,willsave);
  1333.  
  1334.         /* Here we check to see if the temporary array generated for
  1335.          * a foreach needs to be localized because of recursion.
  1336.          */
  1337.         if (tmpsave && (cmd->c_flags & CF_OPTIMIZE) == CFT_ARRAY) {
  1338.             if (lastcmd &&
  1339.               lastcmd->c_type == C_EXPR &&
  1340.               lastcmd->c_expr) {
  1341.             ARG *arg = lastcmd->c_expr;
  1342.  
  1343.             if (arg->arg_type == O_ASSIGN &&
  1344.                 arg[1].arg_type == A_LEXPR &&
  1345.                 arg[1].arg_ptr.arg_arg->arg_type == O_LARRAY &&
  1346.                 strnEQ("_GEN_",
  1347.                   stab_name(
  1348.                 arg[1].arg_ptr.arg_arg[1].arg_ptr.arg_stab),
  1349.                   5)) {    /* array generated for foreach */
  1350.                 (void)localize(arg);
  1351.             }
  1352.             }
  1353.  
  1354.             /* in any event, save the iterator */
  1355.  
  1356.             (void)apush(tosave,cmd->c_short);
  1357.         }
  1358.         shouldsave |= tmpsave;
  1359.         }
  1360.         break;
  1361.     case C_BLOCK:
  1362.     case C_ELSE:
  1363.     case C_IF:
  1364.         if (cmd->ucmd.ccmd.cc_true)
  1365.         shouldsave |= cmd_tosave(cmd->ucmd.ccmd.cc_true,willsave);
  1366.         break;
  1367.     case C_EXPR:
  1368.         if (cmd->ucmd.acmd.ac_expr)
  1369.         shouldsave |= arg_tosave(cmd->ucmd.acmd.ac_expr,willsave);
  1370.         break;
  1371.     }
  1372.     lastcmd = cmd;
  1373.     cmd = cmd->c_next;
  1374.     if (cmd && cmd == head)        /* reached end of while loop */
  1375.         break;
  1376.     }
  1377.     return shouldsave;
  1378. }
  1379.  
  1380. static int
  1381. arg_tosave(arg,willsave)
  1382. register ARG *arg;
  1383. int willsave;
  1384. {
  1385.     register int i;
  1386.     int shouldsave = FALSE;
  1387.  
  1388.     for (i = arg->arg_len; i >= 1; i--) {
  1389.     switch (arg[i].arg_type & A_MASK) {
  1390.     case A_NULL:
  1391.         break;
  1392.     case A_LEXPR:
  1393.     case A_EXPR:
  1394.         shouldsave |= arg_tosave(arg[i].arg_ptr.arg_arg,shouldsave);
  1395.         break;
  1396.     case A_CMD:
  1397.         shouldsave |= cmd_tosave(arg[i].arg_ptr.arg_cmd,shouldsave);
  1398.         break;
  1399.     case A_WORD:
  1400.     case A_STAB:
  1401.     case A_LVAL:
  1402.     case A_READ:
  1403.     case A_GLOB:
  1404.     case A_ARYLEN:
  1405.     case A_SINGLE:
  1406.     case A_DOUBLE:
  1407.     case A_BACKTICK:
  1408.         break;
  1409.     case A_SPAT:
  1410.         shouldsave |= spat_tosave(arg[i].arg_ptr.arg_spat);
  1411.         break;
  1412.     }
  1413.     }
  1414.     switch (arg->arg_type) {
  1415.     case O_RETURN:
  1416.     saw_return = TRUE;
  1417.     break;
  1418.     case O_EVAL:
  1419.     case O_SUBR:
  1420.     shouldsave = TRUE;
  1421.     break;
  1422.     }
  1423.     if (willsave)
  1424.     (void)apush(tosave,arg->arg_ptr.arg_str);
  1425.     return shouldsave;
  1426. }
  1427.  
  1428. static int
  1429. spat_tosave(spat)
  1430. register SPAT *spat;
  1431. {
  1432.     int shouldsave = FALSE;
  1433.  
  1434.     if (spat->spat_runtime)
  1435.     shouldsave |= arg_tosave(spat->spat_runtime,FALSE);
  1436.     if (spat->spat_repl) {
  1437.     shouldsave |= arg_tosave(spat->spat_repl,FALSE);
  1438.     }
  1439.  
  1440.     return shouldsave;
  1441. }
  1442.  
  1443.